home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / makecas.com / MAKECASE.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-09-09  |  4.4 KB  |  147 lines
  1. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 16384,0,655360}
  3.  
  4. program MakeCase;
  5.  
  6. {
  7. Program to generate a case statement of menu choices from a source
  8. code file created by Turbo Professional's MakeMenu utility.
  9.  
  10. This code ain't pretty, but it works.
  11.  
  12. Version 1.00     9 September 1989
  13. Copyright 1989 by John R. Ackermann, Jr.
  14.  
  15. Unlimited use may be made of this program under the following conditions:
  16.  
  17. 1)  The user agrees that this program is provided on an "as-is" basis with
  18.     no warranties whatsoever.  Under no circumstances will the author be
  19.     liable for any damage allegedly resulting from its use.
  20.  
  21. 2)  If the source code is distributed, this notice may not be removed, and
  22.     any changes from the original must be noted, together with the name of
  23.     the author of the changes.
  24.  
  25. NOTES:
  26. 1)  This program requires Turbo Professional 5 to compile.  But then again,
  27.     if you don't already have TP, you don't need this program!
  28.  
  29. 2)  I developed and tested this program around the code generated by MakeMenu
  30.     in TP Version 5.07.  I don't know if code generated by another version
  31.     will work or not.  In particular, if leading blanks or zeros are added
  32.     to any of the parameters of the MenuItem procedure, everything will go
  33.     out of whack.
  34.  
  35. 3)  I truncate NameString to 15 characters to allow more room for a long
  36.     function name to the right of the colon.  This value can easily be
  37.     by changing the last parameter at line 106 from 15 to another value, and
  38.     by changing the "Copy(Blank,1,15)" statement at line 124 to match the new
  39.     length.
  40.  
  41. }
  42.  
  43. uses TPCrt,TPString;
  44.  
  45. var
  46. InFile,OutFile : text;
  47. InString,WorkString : string[255];
  48. TempString : string[10];
  49. InFileString,OutFileString : string[60];
  50. Position : byte;
  51. TempWord,Code : word;
  52.  
  53. const
  54. BlankString : string =
  55. '                                                                            ';
  56. begin
  57. ClrScr;
  58.  
  59. { get input file }
  60. gotoXY(12,12);
  61. write('Enter input file name: ');
  62. ReadLn(InFileString);
  63. InFileString := CleanPathName(InFileString);
  64. assign(InFile,InFileString);
  65. Reset(InFile);
  66. if (IOResult <> 0) or (Trim(InFileString) = '') then
  67.   begin
  68.   writeln('Unable to open input file: ' + InFileString);
  69.   halt(1);
  70.   end;
  71.  
  72. { get output file }
  73. gotoXY(12,14);
  74. write('Enter output file name: ');
  75. ReadLn(OutFileString);
  76. OutFileString := CleanPathName(OutFileString);
  77. assign(OutFile,OutFileString);
  78. Rewrite(OutFile);
  79. if (IOResult <> 0) or (Trim(OutFileString) = '') then
  80.   begin
  81.   writeln('Unable to open output file: ' + OutFileString);
  82.   halt(1);
  83.   end;
  84.  
  85. { output a header }
  86. writeln(OutFile,'');
  87. writeln(OutFile,'{ Case statement generated by MakeCase from ',InFileString,
  88.         ' }');
  89. writeln(OutFile,'Case Key of ');
  90.  
  91. { loop through input file }
  92. while not EOF(InFile) do
  93.   begin
  94.   ReadLn(InFile,InString);
  95.   InString :=  TrimLead(InString);
  96.   { is it a menu item? }
  97.   if Copy(InString,1,8) = 'MenuItem' then
  98.     begin
  99.     { trim off "MenuItem('" }
  100.     Delete(InString,1,10);
  101.  
  102.     { where's the end of NameString? }
  103.     Position := Pos(#39,InString) - 1;
  104.  
  105.     { turn the first 15 characters of NameString into a comment}
  106.     WorkString := Copy(Copy(InString,1,Position),1,15);
  107.     WorkString := '{' + WorkString + '}';
  108.  
  109.     { get rid of NameString and the trailing "'," }
  110.     Delete(InString,1,Position + 2);
  111.  
  112.     { get rid of DisplayPosP }
  113.     Delete(InString,1,Pos(',',InString));
  114.  
  115.     { get rid of SelectPosP }
  116.     Delete(InString,1,Pos(',',InString));
  117.  
  118.     { get the menu choice, KeyP, convert it to an integer and convert it back
  119.       to TempString formatted to 3 places }
  120.     Val(Copy(InString,1,Pos(',',InString) - 1),TempWord,Code);
  121.     Str(TempWord:3,TempString);
  122.  
  123.     { now add " :  ; " to create the case statement }
  124.     WorkString := WorkString + Copy(BlankString,1,(15 - Length(WorkString))) +
  125.                   TempString + ' :  ;';
  126.  
  127.     { write WorkString to the output file }
  128.     WriteLn(OutFile,WorkString);
  129.     end;
  130. end;
  131.  
  132. { write an else statement so that we don't bomb out of an unimplemented
  133.   function }
  134. writeln(OutFile,'else');
  135. writeln(OutFile,'  begin');
  136. writeln(OutFile,'  gotoXY(17,12);');
  137. writeln(OutFile,
  138.         '  write(#7,''Sorry... this function isn''''t implemented yet.'');');
  139. writeln(OutFile,'  delay(2000);');
  140. writeln(OutFile,'  end;');
  141. writeln(OutFile,'end;');
  142. writeln(OutFile,'');
  143.  
  144. { close both files }
  145. Close(InFile);
  146. Close(OutFile);
  147. end.